home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr01 / halcn305.zip / GSOB_INX.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-22  |  16KB  |  571 lines
  1. unit GSOB_INX;
  2. {------------------------------------------------------------------------------
  3.                                  Index Handler
  4.  
  5.        GSWN_INX Copyright (c)  Richard F. Griffin
  6.  
  7.        01 February 1993
  8.  
  9.        102 Molded Stone Pl
  10.        Warner Robins, GA  31088
  11.  
  12.        -------------------------------------------------------------
  13.        This unit handles the objects for all indexed lists.
  14.  
  15.        changes:
  16.  
  17.           22 Jul 93 - Corrected routines so that the collection pool
  18.           file is not created until it is needed.  As long as a list
  19.           is under 16K, the file is not needed.  This allows programs to
  20.           be run from a read-only drive such as CD-ROM, as long as the
  21.           lists do not become so large the routines attempt to ReWrite
  22.           a .CPL file on the default CD-ROM.
  23.  
  24. -------------------------------------------------------------------------------}
  25. {$O+}
  26.  
  27. interface
  28.  
  29. uses
  30.    GSOB_Var,
  31.    GSOB_Dsk,                          {File handler routines}
  32.    GSOB_Str,                          {String handler routines,}
  33.    {$IFDEF WINDOWS}
  34.       Objects;
  35.    {$ELSE}
  36.       GSOB_Obj;
  37.    {$ENDIF}
  38.  
  39. const
  40.  
  41.    ixAscending      = true;
  42.    ixDescending     = false;
  43.  
  44.    IndexPageSize = 16384;
  45.    MaxTagValue   = MaxLongint;
  46.    NilTagValue   = -1;
  47.    NoTagValue    = -2;
  48.  
  49. type
  50.  
  51.    ixFileStatus = (ixInvalid, ixNotUpdated, ixUpdated);
  52.  
  53.    ixKeyString  = string;
  54.  
  55.    GSP_IndxEtry = ^GSR_IndxEtry;
  56.    GSR_IndxEtry = Record
  57.       Tag         : Longint;
  58.       KeyStr      : String;
  59.    end;
  60.  
  61.    GSP_IndxFile = ^GSO_IndxFile;
  62.    GSO_IndxFile = Object(GSO_DiskFile)
  63.       IndxBufr    : PByteArray;
  64.       Next_Blk    : Longint;
  65.       constructor Init;
  66.       destructor  Done; virtual;
  67.       procedure   ReleasePage(page: longint); virtual;
  68.       function    GetPageNo: longint; virtual;
  69.    end;
  70.  
  71.    GSP_IndxColl = ^GSO_IndxColl;
  72.    GSO_IndxColl = Object(TCollection)
  73.       ixSortType  : SortStatus;
  74.       EntrySize   : integer;
  75.       KeyLength   : integer;
  76.       KeysOnPage  : integer;
  77.       ixBufrSize  : word;
  78.       ixBufrKeys  : integer;
  79.       WorkPage    : integer;
  80.       LastGoTo    : longint;
  81.       KeyCount    : longint;
  82.       BOF_Key     : boolean;
  83.       EOF_Key     : boolean;
  84.       constructor Init(KLength : integer; sorttype : SortStatus);
  85.       constructor InitNode(CLink : GSP_IndxColl);
  86.       procedure   EndRetrieve; virtual;
  87.       procedure   InsertKey(recno: longint; s: string); virtual;
  88.       function    MakeNewPage : pointer; virtual;
  89.       function    PickKey(knum : longint) : GSP_IndxEtry; virtual;
  90.       function    RetrieveKey : GSP_IndxEtry; virtual;
  91.       procedure   StoreIndex(p : GSP_IndxColl; recnode : boolean); virtual;
  92.    end;
  93.  
  94.    GSP_IndxPage = ^GSO_IndxPage;
  95.    GSO_IndxPage = Object(TSortedCollection)
  96.       CollLink    : GSP_IndxColl;   {Link to collection owner}
  97.       Etry_No     : integer;        {Last entry accessed}
  98.       Etry_Up     : integer;
  99.       IsActive    : boolean;        {True if page is in memory, false if filed}
  100.       Last_Key    : GSP_IndxEtry;   {Last Key in page. Valid only when filed}
  101.       Page_No     : longint;        {Disk block holding filed page}
  102.       IndxRBuf    : PByteArray;
  103.       RBufEtry    : integer;
  104.       RBufPosn    : integer;
  105.       RBufStep    : integer;
  106.       RBufSize    : word;
  107.       RKeyLgth    : integer;
  108.       constructor Init(CLink : pointer);
  109.       destructor  Done; virtual;
  110.       procedure   AtInsert(Index: Integer; Item : pointer); virtual;
  111.       procedure   CheckLimit; virtual;
  112.       function    Compare(Key1, Key2 : pointer) : integer; virtual;
  113.       procedure   FreeAllElements; virtual;
  114.       procedure   Insert(Item : pointer); virtual;
  115.       procedure   PageLoad; virtual;
  116.       procedure   PageStore; virtual;
  117.       procedure   Retrieve; virtual;
  118.       procedure   SetBuffer(BSize, BKeys, BLgth:Integer); virtual;
  119.    end;
  120.  
  121. var
  122.    ExactIndexMatch : boolean;
  123.    CollPool : GSP_IndxFile;
  124.    KeepEntry : GSR_IndxEtry;
  125.  
  126. {------------------------------------------------------------------------------
  127.                                IMPLEMENTATION SECTION
  128. ------------------------------------------------------------------------------}
  129.  
  130. implementation
  131.  
  132. const
  133.  
  134.    ValueHigh   = 1;    {Token value passed for key comparison high}
  135.    ValueLow    = -1;   {Token value passed for key comparison low}
  136.    ValueEqual  = 0;    {Token value passed for key comparison equal}
  137.  
  138.    Null_Key = 0;    {file not accessed yet}
  139.    Next_Key = -1;   {Token value passed to read next record}
  140.    Prev_Key = -2;   {Token value passed to read previous record}
  141.    Top_Key  = -3;   {Token value passed to read first record}
  142.    Bttm_Key = -4;   {Token value passed to read final record}
  143.    Same_Key = -5;   {Token value passed to re-read the record}
  144.    EOF_Key  = -6;   {Token value returned if access beyond EOF/TOF}
  145.  
  146.    EtryAdjust = 5;  {Added to Key Length to account for GSR_IndxEtry size}
  147.  
  148. var
  149.    ExitSave : pointer;
  150.    Etry_Ptr : GSP_IndxEtry;
  151.    Page_Ptr : GSP_IndxPage;
  152.  
  153. {------------------------------------------------------------------------------
  154.                                GSO_IndxFile
  155. ------------------------------------------------------------------------------}
  156.  
  157. constructor GSO_IndxFile.Init;
  158. var
  159.    fn : string[12];
  160. begin
  161.    fn := Unique_Field + '.CPx';
  162.    GSO_DiskFile.Init(fn,dfReadWrite);
  163.    GetMem(IndxBufr,IndexPageSize);
  164.    if IndxBufr = nil then exit;
  165.    GSO_DiskFile.Rewrite(1);
  166.    Next_Blk := 0;
  167. end;
  168.  
  169. destructor GSO_IndxFile.Done;
  170. begin
  171.    if IndxBufr <> nil then FreeMem(IndxBufr,IndexPageSize);
  172.    Close;
  173.    Erase;
  174.    GSO_DiskFile.Done;
  175.    CollPool := nil;
  176. end;
  177.  
  178. function GSO_IndxFile.GetPageNo: longint;
  179. begin
  180.    GetPageNo := Next_Blk;
  181.    if FileSize = Next_Blk then inc(Next_Blk,IndexPageSize)
  182.    else
  183.    begin
  184.       Read(Next_Blk,IndxBufr^,4);
  185.       move(IndxBufr^,Next_Blk,4);
  186.    end;
  187. end;
  188.  
  189. procedure GSO_IndxFile.ReleasePage(page: longint);
  190. begin
  191.    if page <> -1 then
  192.    begin
  193.       move(Next_Blk,IndxBufr^,4);
  194.       Next_Blk := page;
  195.       Write(Next_Blk,IndxBufr^,4);
  196.    end;
  197. end;
  198.  
  199. {------------------------------------------------------------------------------
  200.                                GSO_IndxColl
  201. ------------------------------------------------------------------------------}
  202.  
  203. constructor GSO_IndxColl.Init(KLength : integer; sorttype : SortStatus);
  204. var
  205.    p  : pointer;
  206.    fn : string[12];
  207. begin
  208.    TCollection.Init(64,32);
  209.    ixSortType := sorttype;
  210.    KeyLength := KLength;
  211.    EntrySize := KeyLength+EtryAdjust;  {Key length+length byte+SizeOf(longint)}
  212.    KeysOnPage :=  (IndexPageSize div EntrySize) - 1;
  213.    p := MakeNewPage;
  214.    Insert(p);
  215.    WorkPage := 0;
  216.    ixBufrSize := 0;
  217.    ixBufrKeys := 0;
  218.    LastGoTo := Null_Key;
  219.    KeyCount := 0;
  220.    BOF_Key := false;
  221.    EOF_Key := false;
  222. end;
  223.  
  224. constructor GSO_IndxColl.InitNode(CLink : GSP_IndxColl);
  225. begin
  226.    Init(CLink^.KeyLength,CLink^.ixSortType);
  227. end;
  228.  
  229. Procedure GSO_IndxColl.EndRetrieve;
  230. var
  231.    i : integer;
  232.    w : GSP_IndxPage;
  233. begin
  234.    if ixBufrSize = 0 then exit;
  235.    for i := 0 to Count-1 do
  236.    begin
  237.       w := Items^[i];
  238.       if w^.IndxRBuf <> nil then FreeMem(w^.IndxRBuf, w^.RBufSize);
  239.       w^.IndxRBuf := nil;
  240.    end;
  241.    ixBufrSize := 0;
  242. end;
  243.  
  244. procedure GSO_IndxColl.InsertKey(recno: longint; s: string);
  245. var
  246.    p : GSP_IndxEtry;
  247.    w : GSP_IndxPage;
  248. begin
  249.    GetMem(p, EntrySize);
  250.    move(s, p^.KeyStr, KeyLength+1);
  251.    p^.Tag := recno;
  252.    w := Items^[WorkPage];
  253.    if ixSortType = NoSort then
  254.       w^.AtInsert(w^.Count, p)
  255.    else
  256.       w^.Insert(p);
  257.    inc(KeyCount);
  258. end;
  259.  
  260. function GSO_IndxColl.MakeNewPage : pointer;
  261. begin
  262.    MakeNewPage := New(GSP_IndxPage, Init(@Self));
  263. end;
  264.  
  265.  
  266. function GSO_IndxColl.PickKey(knum : longint) : GSP_IndxEtry;
  267. var
  268.    e : integer;
  269.    i : integer;
  270.    p : GSP_IndxEtry;
  271.    w : GSP_IndxPage;
  272. begin
  273.    BOF_Key := false;
  274.    EOF_Key := false;
  275.    if GSP_IndxPage(Items^[WorkPage])^.Count = 0 then
  276.    begin
  277.       PickKey := nil;
  278.       exit;                          {No keys in the file}
  279.    end;
  280.    if (LastGoTo = Null_Key) then
  281.    begin                             {This is the first read}
  282.       case knum of
  283.          Next_Key  : knum := Top_Key;
  284.          Prev_Key  : knum := Bttm_Key;
  285.       end;
  286.    end;
  287.    case knum of
  288.       Top_Key   : LastGoTo := 1;
  289.       Bttm_Key  : LastGoTo := KeyCount;
  290.       Next_Key  : inc(LastGoTo);
  291.       Prev_Key  : dec(LastGoTo);
  292.       else LastGoTo := knum;
  293.    end;
  294.    if LastGoTo < 1 then BOF_Key := true
  295.       else if LastGoTo > KeyCount then EOF_Key := true;
  296.    if BOF_Key or EOF_Key then PickKey := nil
  297.    else
  298.    begin
  299.       e := (LastGoTo-1) div KeysOnPage;
  300.       i := (LastGoTo-1) mod KeysOnPage;
  301.       w := Items^[e];
  302.       if e <> WorkPage then
  303.       begin
  304.          GSP_IndxPage(Items^[WorkPage])^.PageStore;
  305.          w^.PageLoad;
  306.          WorkPage := e;
  307.       end;
  308.       p := GSP_IndxEtry(w^.Items^[i]);
  309.       move(p^, KeepEntry, EntrySize);
  310.       PickKey := @KeepEntry;
  311.    end;
  312. end;
  313.  
  314.  
  315. function GSO_IndxColl.RetrieveKey : GSP_IndxEtry;
  316. var
  317.    e : integer;
  318.    f : integer;
  319.    i : longint;
  320.    m : longint;
  321.    p : GSP_IndxEtry;
  322.    q : GSP_IndxEtry;
  323.    w : GSP_IndxPage;
  324. begin
  325.    if GSP_IndxPage(Items^[WorkPage])^.Count = 0 then
  326.    begin
  327.       RetrieveKey := nil;
  328.       exit;
  329.    end;
  330.    if ixBufrSize = 0 then
  331.    begin
  332.       m := MemAvail;
  333.       m := m - (IndexPageSize*2);
  334.       m := m div Count;
  335.       i := IndexPageSize div 8;
  336.       while (i > m) and (i > 128) do i := i div 2;
  337.       if i = 128 then Error(tpHeapOverFlow, inxRetrieveKeyError);
  338.       ixBufrSize := i;
  339.       ixBufrKeys := ixBufrSize div EntrySize;
  340.       if Count > 1 then
  341.       begin
  342.          for f := 0 to Count-1 do
  343.          begin
  344.             w := Items^[f];
  345.             if not w^.IsActive then
  346.                w^.SetBuffer(i,ixBufrKeys, EntrySize);
  347.          end;
  348.       end;
  349.    end;
  350.    e := -1;
  351.    i := 0;
  352.    while (i < Count) do
  353.    begin
  354.       w := Items^[i];
  355.       if w^.Etry_Up < w^.Etry_No then
  356.       begin
  357.          if w^.IsActive then q := w^.At(w^.Etry_Up)
  358.             else  q := w^.Last_Key;
  359.          if e = -1 then
  360.          begin
  361.             e := i;
  362.             p := q;
  363.          end
  364.          else
  365.          begin
  366.             if w^.Compare(p, q) > 0 then
  367.             begin
  368.                e := i;
  369.                p := q;
  370.             end;
  371.          end;
  372.       end;
  373.       inc(i);
  374.    end;
  375.    if e = -1 then
  376.    begin
  377.       RetrieveKey := nil;
  378.       exit;
  379.    end;
  380.    move(p^, KeepEntry, EntrySize);
  381.    RetrieveKey := @KeepEntry;
  382.    w := Items^[e];
  383.    w^.Retrieve;
  384. end;
  385.  
  386. Procedure GSO_IndxColl.StoreIndex(p : GSP_IndxColl; recnode : boolean);
  387. begin
  388. end;
  389.  
  390. {------------------------------------------------------------------------------
  391.                                GSO_IndxPage
  392. ------------------------------------------------------------------------------}
  393.  
  394. constructor GSO_IndxPage.Init(CLink : pointer);
  395. begin
  396.    TSortedCollection.Init(GSP_IndxColl(CLink)^.KeysOnPage+1,64);
  397.    IndxRBuf := nil;
  398.    IsActive := true;
  399.    Page_No := -1;
  400.    Last_Key := nil;
  401.    Etry_No := -1;
  402.    Etry_Up := 0;
  403.    CollLink := CLink;
  404. end;
  405.  
  406. destructor GSO_IndxPage.Done;
  407. begin
  408.    if Page_No >= 0 then CollPool^.ReleasePage(Page_No);
  409.    FreeAllElements;
  410.    if IndxRBuf <> nil then FreeMem(IndxRBuf, RBufSize);
  411.    if Last_Key <> nil then FreeMem(Last_Key,CollLink^.EntrySize);
  412.    TSortedCollection.Done;
  413. end;
  414.  
  415. procedure GSO_IndxPage.AtInsert(Index: Integer; Item : Pointer);
  416. begin
  417.    TCollection.AtInsert(Index,Item);
  418.    Etry_No := Count;
  419.    CheckLimit;
  420. end;
  421.  
  422. procedure GSO_IndxPage.CheckLimit;
  423. var
  424.    p : GSP_IndxPage;
  425. begin
  426.    if Count <= CollLink^.KeysOnPage then exit;
  427.    p := CollLink^.MakeNewPage;
  428.    CollLink^.AtInsert(CollLink^.WorkPage+1,p);
  429.    inc(CollLink^.WorkPage);
  430.    PageStore;
  431. end;
  432.  
  433. function GSO_IndxPage.Compare(Key1, Key2 : pointer) : integer;
  434. var
  435.    k1  : GSP_IndxEtry absolute Key1;
  436.    k2  : GSP_IndxEtry absolute Key2;
  437.    flg : integer;
  438. begin
  439.    if (Key1 = nil) or (Key2 = nil) then
  440.    begin
  441.       if (Key1 = nil) and (Key2 = nil) then flg := ValueEqual
  442.          else if Key1 = nil then flg := ValueLow
  443.             else flg := ValueHigh;
  444.    end
  445.    else
  446.    begin
  447.       if k1^.KeyStr <  k2^.KeyStr then flg := ValueLow
  448.          else if k1^.KeyStr >  k2^.KeyStr then flg := ValueHigh
  449.             else flg := ValueEqual;
  450.    end;
  451.    if (flg = ValueEqual) and (k2^.Tag <> NoTagValue) then
  452.    begin
  453.       if k1^.Tag = k2^.Tag then flg := ValueEqual
  454.          else if k1^.Tag > k2^.Tag then flg := ValueHigh
  455.             else flg := ValueLow;
  456.    end;
  457.    if CollLink^.ixSortType = SortDown then
  458.       if flg = ValueLow then flg := ValueHigh
  459.          else if flg = ValueHigh then flg := ValueLow;
  460.    Compare := flg;
  461. end;
  462.  
  463. procedure GSO_IndxPage.FreeAllElements;
  464. var
  465.    i : integer;
  466. begin
  467.    for i := 0 to Count-1 do
  468.       FreeMem(Items^[i],length(GSP_IndxEtry(Items^[i])^.KeyStr)+EtryAdjust);
  469.    Count := 0;
  470. end;
  471.  
  472. procedure GSO_IndxPage.Insert(Item : Pointer);
  473. var
  474.    I : integer;
  475.    B : boolean;
  476. begin
  477.    B := Search(KeyOf(Item),I);
  478.    AtInsert(I, Item);
  479. end;
  480.  
  481. procedure GSO_IndxPage.PageLoad;
  482. var
  483.    entsize : integer;
  484.    i       : integer;
  485.    p       : GSP_IndxEtry;
  486.    q       : GSP_IndxEtry;
  487. begin
  488.    entsize := CollLink^.EntrySize;
  489.    IsActive := true;
  490.    if Page_No < 0 then exit;
  491.    CollPool^.Read(Page_No, CollPool^.IndxBufr^, IndexPageSize);
  492.    for i := 0 to Etry_No - 1 do
  493.    begin
  494.       p := @CollPool^.IndxBufr^[i*entsize];
  495.       GetMem(q, entsize);
  496.       move(p^, q^, entsize);
  497.       AtInsert(Count, q);
  498.    end;
  499. end;
  500.  
  501. procedure GSO_IndxPage.PageStore;
  502. var
  503.    entsize : integer;
  504.    i       : integer;
  505. begin
  506.    if CollPool = nil then CollPool := New(GSP_IndxFile, Init);
  507.    entsize := CollLink^.EntrySize;
  508.    if Page_No < 0 then Page_No := CollPool^.GetPageNo;
  509.    IsActive := false;
  510.    Etry_No := Count;
  511.    if Last_Key = nil then GetMem(Last_Key, entsize);
  512.    Move(Items^[0]^, Last_Key^, entsize);
  513.    for i := 0 to Count-1 do
  514.       move(Items^[i]^, CollPool^.IndxBufr^[i*entsize], entsize);
  515.    CollPool^.Write(Page_No, CollPool^.IndxBufr^, IndexPageSize);
  516.    FreeAllElements;
  517.    SetLimit(0);
  518. end;
  519.  
  520. procedure GSO_IndxPage.Retrieve;
  521. var
  522.    i : longint;
  523.    v : integer;
  524.    z : integer;
  525. begin
  526.    inc(Etry_Up);
  527.    if IsActive then exit;
  528.    inc(RBufPosn);
  529.    if RBufPosn >= RBufEtry then
  530.    begin
  531.       RBufPosn := 0;
  532.       v := Etry_No - Etry_Up;
  533.       if v > RBufEtry then v := RBufEtry;
  534.       i := (Page_No) + (Etry_Up * RKeyLgth);
  535.       CollPool^.Read(i,IndxRBuf^, v * RKeyLgth);
  536.    end;
  537.    move(IndxRBuf^[RBufPosn * RKeyLgth], Last_Key^, RKeyLgth);
  538. end;
  539.  
  540. Procedure GSO_IndxPage.SetBuffer(BSize, BKeys, BLgth:Integer);
  541. begin
  542.    RBufSize := BSize;
  543.    RBufEtry := BKeys;
  544.    RBufPosn := 0;
  545.    RBufStep := 0;
  546.    RKeyLgth := BLgth;
  547.    GetMem(IndxRBuf, RBufSize);
  548.    CollPool^.Read(Page_No,IndxRBuf^, RBufSize);
  549. end;
  550.  
  551. {------------------------------------------------------------------------------
  552.                            Setup and Exit Routines
  553. ------------------------------------------------------------------------------}
  554.  
  555. {$F+}
  556. procedure ExitHandler;
  557. begin
  558.    if CollPool <> nil then Dispose(CollPool, Done);
  559.    ExitProc := ExitSave;
  560. end;
  561. {$F-}
  562.  
  563. begin
  564.    ExitSave := ExitProc;
  565.    ExitProc := @ExitHandler;
  566.    ExactIndexMatch := false;
  567.    CollPool := nil;
  568. end.
  569. {----------------------------------------------------------------------------}
  570.                                       END
  571.